This week we’ll cover a few packages for visualizing our data:
ggplot2, our main package for static data visualization with the tidyverse
timetk, a package built by Matt Dancho for working with time series data
plotly, an interactive visualization builder that also integrates nicely with ggplot.
library(tidyverse)
library(timetk)
library(plotly)
library(readxl)
library(janitor)
library(lubridate)
knitr::opts_chunk$set(message = FALSE, warning = FALSE, comment = NA)
Let’s load our HPI dataset, wrangle it, and pivot it into long format.
hpi <- read_excel("HPI_PO_monthly_hist.xls", skip = 3)
hpi_wrangled <- hpi %>%
clean_names() %>%
slice(-1) %>% # remove empty row
rename(date = month) %>%
select(date, ends_with("_sa")) %>% # only keep seasonally adj. data
# separate() from tidyr package to split date into separate columns for day/month/year
separate(date, into = c("year", "month", "day"), sep = '-', convert = TRUE, remove = FALSE) %>%
# unite() from tidyr to join columns
unite(yr_mon, year, month, sep = "/", remove = FALSE) %>%
mutate_if(is.numeric, round, digits = 2) %>% # round all numeric columns to 2 digits
# add labels with case_when()
mutate(season = case_when(between(month, 3, 5) ~ "spring",
between(month, 6, 8) ~ "summer",
between(month, 9, 11) ~ "fall",
# between(month, 12, 2) ~ "winter" == won't work because there's no numbers between 12 and 2
TRUE ~ "winter")) %>%
select(date, yr_mon, year, month, day, season, everything()) %>% # reorder columns
# arrange() from dplyr to sort rows
arrange(date)
hpi_tidy <-
hpi_wrangled %>%
select(date, contains("north"), contains("south")) %>%
# pivot_longer makes data long, or tidy
pivot_longer(-date, names_to = "division", values_to = "hpi") %>%
group_by(division)
hpi_tidy
ggplot2
And now let’s create a basic ggplot.
hpi_tidy %>%
ggplot(aes(x = date, y = hpi, color = division)) +
geom_line() +
theme_minimal() +
labs(x = "Date", y = "House Price Index")

The ggplot2 package uses some unique syntax (the “grammar of graphics”) that allows us to create highly customizable static graphics. This grammar can be a bit hard to grasp, so don’t worry if it takes a while to “click”.
I think about ggplot like this:
- We always start by calling
ggplot() to create our plot object. This is (usually!) where we will specify our data and aesthetic mappings, or how our variables should map onto features of the plot like axes, colored groupings, etc.
- Then we add geoms to our plot. This is the step that will actually display our data on the graph. We will always have at least one of these, and sometimes multiple.
- Finally, we can change the appearance of our plot by adding things like themes and changing titles and captions.
Let’s dissect the code above to understand each step.
Wait, why a + instead of %>%? You can think of ggplots in layers. At each step, we’re adding a new layer, like we’re painting on a canvas. This is different than the pipe, which is for passing an object along to a new function.
Faceting
Another thing we can “add” to our ggplots is a faceting layer. Facets divide a plot into subplots based on one of our variables. For example:
ggplot(hpi_tidy, aes(x = date, y = hpi, color = division)) +
geom_line() +
facet_wrap(~division)

Scatterplot
There are many kinds of geoms we can add. For example, a scatterplot uses geom_point().

Scatterplot with trend line
We can also add multiple geoms to a ggplot object, e.g. adding a trend line to our scatterplots:
hpi_pct %>%
ggplot(aes(x = pct_change_12_mons, y = pct_change, color = division)) +
geom_point() + #alpha = .5
geom_smooth(method = "lm", se = TRUE, color = "purple") +
facet_wrap(~division, ncol = 4) +
labs(x = "% change (1 mo.)", y = "% change (1 yr.)") +
theme(legend.position = "none",
axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5),
plot.title = element_text(hjust = 0.5))

Histogram
There are lots of ways to customize the look and feel of your plots:
hpi_pct %>%
ggplot(aes(x = pct_change)) +
geom_histogram(fill = "darkblue", color = "darkred", bins = 10) +
facet_wrap(~division) +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
theme_minimal()

Density
hpi_pct %>%
ggplot(aes(x = pct_change)) +
geom_density(fill = "darkblue", color = "darkred", bins = 50) +
facet_wrap(~division) +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
theme_minimal()

Histogram and Density
hpi_pct %>%
ggplot(aes(x = pct_change)) +
geom_histogram(fill = "darkblue", color = "darkred", bins = 20) +
geom_density(color = "red") +
facet_wrap(~division) +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5))

Shading for recession
We can even combine datasets on the same plot. Let’s create a geom to shade the background of a plot during recession periods.
# First, create our recessions tibble with tribble()
recessions <-
tribble(
~Peak, ~Trough,
"1948-11-01", "1949-10-01",
"1953-07-01", "1954-05-01",
"1957-08-01", "1958-04-01",
"1960-04-01", "1961-02-01",
"1969-12-01", "1970-11-01",
"1973-11-01", "1975-03-01",
"1980-01-01", "1980-07-01",
"1981-07-01", "1982-11-01",
"1990-07-01", "1991-03-01",
"2001-03-01", "2001-11-01",
"2007-12-01", "2009-06-01",
"2020-02-01", "2020-05-01"
) %>%
mutate(Peak = ymd(Peak),
Trough = ymd(Trough))
recession_shade <-
geom_rect(data = recessions,
inherit.aes = F,
aes(xmin = Peak,
xmax = Trough,
ymin = -Inf,
ymax = +Inf),
fill = 'pink',
alpha = 0.5)
hpi_pct %>%
ggplot(aes(x = ymd(date), y = pct_change, color = division)) +
recession_shade +
geom_line() +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, hjust = 1),
plot.title = element_text(hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5),
plot.caption = element_text(hjust=0)) +
ylab("") +
xlab("Percent change, monthly") +
ggtitle("Housing Price Appreciation",
subtitle = "by US Census Division") +
labs(caption = "data source: FHFA") +
scale_x_date(limits = c(as.Date(min(hpi_pct$date)), as.Date(max(hpi_pct$date))))

timetk for time series data
The timetk package includes a bunch of functions that make working with time series data super easy. This includes functions for easily creating great looking plots of time series data:
hpi_pct %>%
ungroup() %>%
plot_time_series(date, pct_change, .color_var = division, .smooth = FALSE, .interactive = FALSE)

Anomaly diagnostics with timetk
timetk also includes functions for automatic anomaly detection:
hpi_pct %>%
filter(division == "south_atlantic_sa") %>%
ungroup() %>%
plot_anomaly_diagnostics(date, pct_change)
Plotly and ggplotly()
timetk’s interactive plots rely on plotly, a library for building interactive JavaScript visualizations. Plotly is supported in several different languages (including R) and has its own syntax.
Importantly, the plotly R package includes a function called ggplotly() that (you guessed it!) turns ggplots into plotly charts.
hpi_plot <- ggplot(hpi_tidy, aes(x = date, y = hpi, color = division)) +
geom_line()
hpi_plot %>%
ggplotly()
LS0tCnRpdGxlOiAiRGF0YSBWaXN1YWxpemF0aW9uIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCgpUaGlzIHdlZWsgd2UnbGwgY292ZXIgYSBmZXcgcGFja2FnZXMgZm9yIHZpc3VhbGl6aW5nIG91ciBkYXRhOgoKKiBbYGdncGxvdDJgXShodHRwczovL2dncGxvdDIudGlkeXZlcnNlLm9yZy8pLCBvdXIgbWFpbiBwYWNrYWdlIGZvciBzdGF0aWMgZGF0YSB2aXN1YWxpemF0aW9uIHdpdGggdGhlIHRpZHl2ZXJzZQoqIFtgdGltZXRrYF0oaHR0cHM6Ly9idXNpbmVzcy1zY2llbmNlLmdpdGh1Yi5pby90aW1ldGsvaW5kZXguaHRtbCksIGEgcGFja2FnZSBidWlsdCBieSBNYXR0IERhbmNobyBmb3Igd29ya2luZyB3aXRoIHRpbWUgc2VyaWVzIGRhdGEKKiBbYHBsb3RseWBdKGh0dHBzOi8vZ2l0aHViLmNvbS9yb3BlbnNjaS9wbG90bHkpLCBhbiBpbnRlcmFjdGl2ZSB2aXN1YWxpemF0aW9uIGJ1aWxkZXIgdGhhdCBhbHNvIGludGVncmF0ZXMgbmljZWx5IHdpdGggZ2dwbG90LgoKYGBge3Igc2V0dXAsIG1lc3NhZ2UgPSBGQUxTRSwgd2FybmluZyA9IEZBTFNFfQpsaWJyYXJ5KHRpZHl2ZXJzZSkKbGlicmFyeSh0aW1ldGspCmxpYnJhcnkocGxvdGx5KQpsaWJyYXJ5KHJlYWR4bCkKbGlicmFyeShqYW5pdG9yKQpsaWJyYXJ5KGx1YnJpZGF0ZSkKCmtuaXRyOjpvcHRzX2NodW5rJHNldChtZXNzYWdlID0gRkFMU0UsIHdhcm5pbmcgPSBGQUxTRSwgY29tbWVudCA9IE5BKQpgYGAKCgpMZXQncyBsb2FkIG91ciBIUEkgZGF0YXNldCwgd3JhbmdsZSBpdCwgYW5kIHBpdm90IGl0IGludG8gbG9uZyBmb3JtYXQuCgpgYGB7cn0KaHBpIDwtIHJlYWRfZXhjZWwoIkhQSV9QT19tb250aGx5X2hpc3QueGxzIiwgc2tpcCA9IDMpCgpocGlfd3JhbmdsZWQgPC0gaHBpICU+JSAKICBjbGVhbl9uYW1lcygpICU+JSAKICBzbGljZSgtMSkgJT4lICAgIyByZW1vdmUgZW1wdHkgcm93CiAgcmVuYW1lKGRhdGUgPSBtb250aCkgJT4lCiAgc2VsZWN0KGRhdGUsIGVuZHNfd2l0aCgiX3NhIikpICU+JSAgIyBvbmx5IGtlZXAgc2Vhc29uYWxseSBhZGouIGRhdGEKICAjIHNlcGFyYXRlKCkgZnJvbSB0aWR5ciBwYWNrYWdlIHRvIHNwbGl0IGRhdGUgaW50byBzZXBhcmF0ZSBjb2x1bW5zIGZvciBkYXkvbW9udGgveWVhciAKICBzZXBhcmF0ZShkYXRlLCBpbnRvID0gYygieWVhciIsICJtb250aCIsICJkYXkiKSwgc2VwID0gJy0nLCBjb252ZXJ0ID0gVFJVRSwgcmVtb3ZlID0gRkFMU0UpICU+JSAKICAjIHVuaXRlKCkgZnJvbSB0aWR5ciB0byBqb2luIGNvbHVtbnMgCiAgdW5pdGUoeXJfbW9uLCB5ZWFyLCBtb250aCwgc2VwID0gIi8iLCByZW1vdmUgPSBGQUxTRSkgJT4lIAogIG11dGF0ZV9pZihpcy5udW1lcmljLCByb3VuZCwgZGlnaXRzID0gMikgJT4lICAjIHJvdW5kIGFsbCBudW1lcmljIGNvbHVtbnMgdG8gMiBkaWdpdHMKICAjIGFkZCBsYWJlbHMgd2l0aCBjYXNlX3doZW4oKQogIG11dGF0ZShzZWFzb24gPSBjYXNlX3doZW4oYmV0d2Vlbihtb250aCwgMywgNSkgfiAic3ByaW5nIiwKICAgICAgICAgICAgICAgICAgICAgICAgICAgIGJldHdlZW4obW9udGgsIDYsIDgpIH4gInN1bW1lciIsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICBiZXR3ZWVuKG1vbnRoLCA5LCAxMSkgfiAiZmFsbCIsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAjIGJldHdlZW4obW9udGgsIDEyLCAyKSB+ICJ3aW50ZXIiID09IHdvbid0IHdvcmsgYmVjYXVzZSB0aGVyZSdzIG5vIG51bWJlcnMgYmV0d2VlbiAxMiBhbmQgMgogICAgICAgICAgICAgICAgICAgICAgICAgICAgVFJVRSB+ICJ3aW50ZXIiKSkgJT4lIAogIHNlbGVjdChkYXRlLCB5cl9tb24sIHllYXIsIG1vbnRoLCBkYXksIHNlYXNvbiwgZXZlcnl0aGluZygpKSAlPiUgICMgcmVvcmRlciBjb2x1bW5zCiAgIyBhcnJhbmdlKCkgZnJvbSBkcGx5ciB0byBzb3J0IHJvd3MKICBhcnJhbmdlKGRhdGUpCgpocGlfdGlkeSA8LSAKICBocGlfd3JhbmdsZWQgJT4lIAogIHNlbGVjdChkYXRlLCBjb250YWlucygibm9ydGgiKSwgY29udGFpbnMoInNvdXRoIikpICU+JSAKICAjIHBpdm90X2xvbmdlciBtYWtlcyBkYXRhIGxvbmcsIG9yIHRpZHkKICBwaXZvdF9sb25nZXIoLWRhdGUsIG5hbWVzX3RvID0gImRpdmlzaW9uIiwgdmFsdWVzX3RvID0gImhwaSIpICU+JSAKICBncm91cF9ieShkaXZpc2lvbikgCgpocGlfdGlkeQpgYGAKCiMgYGdncGxvdDJgCgpBbmQgbm93IGxldCdzIGNyZWF0ZSBhIGJhc2ljIGBnZ3Bsb3RgLgoKYGBge3J9CmhwaV90aWR5ICU+JSAKZ2dwbG90KGFlcyh4ID0gZGF0ZSwgeSA9IGhwaSwgY29sb3IgPSBkaXZpc2lvbikpICsKICBnZW9tX2xpbmUoKSArCiAgdGhlbWVfbWluaW1hbCgpICsKICBsYWJzKHggPSAiRGF0ZSIsIHkgPSAiSG91c2UgUHJpY2UgSW5kZXgiKQpgYGAKClRoZSBgZ2dwbG90MmAgcGFja2FnZSB1c2VzIHNvbWUgdW5pcXVlIHN5bnRheCAodGhlICJncmFtbWFyIG9mIGdyYXBoaWNzIikgdGhhdCBhbGxvd3MgdXMgdG8gY3JlYXRlIGhpZ2hseSBjdXN0b21pemFibGUgc3RhdGljIGdyYXBoaWNzLiBUaGlzIGdyYW1tYXIgY2FuIGJlIGEgYml0IGhhcmQgdG8gZ3Jhc3AsIHNvIGRvbid0IHdvcnJ5IGlmIGl0IHRha2VzIGEgd2hpbGUgdG8gImNsaWNrIi4KCkkgdGhpbmsgYWJvdXQgZ2dwbG90IGxpa2UgdGhpczoKCiogV2UgYWx3YXlzIHN0YXJ0IGJ5IGNhbGxpbmcgYGdncGxvdCgpYCB0byBjcmVhdGUgb3VyIHBsb3Qgb2JqZWN0LiBUaGlzIGlzICh1c3VhbGx5ISkgd2hlcmUgd2Ugd2lsbCBzcGVjaWZ5IG91ciBkYXRhIGFuZCAqYWVzdGhldGljIG1hcHBpbmdzKiwgb3IgaG93IG91ciB2YXJpYWJsZXMgc2hvdWxkIG1hcCBvbnRvIGZlYXR1cmVzIG9mIHRoZSBwbG90IGxpa2UgYXhlcywgY29sb3JlZCBncm91cGluZ3MsIGV0Yy4KKiBUaGVuIHdlIGFkZCAqZ2VvbXMqIHRvIG91ciBwbG90LiBUaGlzIGlzIHRoZSBzdGVwIHRoYXQgd2lsbCBhY3R1YWxseSBkaXNwbGF5IG91ciBkYXRhIG9uIHRoZSBncmFwaC4gV2Ugd2lsbCBhbHdheXMgaGF2ZSBhdCBsZWFzdCBvbmUgb2YgdGhlc2UsIGFuZCBzb21ldGltZXMgbXVsdGlwbGUuCiogRmluYWxseSwgd2UgY2FuIGNoYW5nZSB0aGUgYXBwZWFyYW5jZSBvZiBvdXIgcGxvdCBieSBhZGRpbmcgdGhpbmdzIGxpa2UgKnRoZW1lcyogYW5kIGNoYW5naW5nIHRpdGxlcyBhbmQgY2FwdGlvbnMuCgpMZXQncyBkaXNzZWN0IHRoZSBjb2RlIGFib3ZlIHRvIHVuZGVyc3RhbmQgZWFjaCBzdGVwLgoKV2FpdCwgd2h5IGEgYCtgIGluc3RlYWQgb2YgYCU+JWA/IFlvdSBjYW4gdGhpbmsgb2YgZ2dwbG90cyBpbiBsYXllcnMuIEF0IGVhY2ggc3RlcCwgd2UncmUgYWRkaW5nIGEgbmV3IGxheWVyLCBsaWtlIHdlJ3JlIHBhaW50aW5nIG9uIGEgY2FudmFzLiBUaGlzIGlzIGRpZmZlcmVudCB0aGFuIHRoZSBwaXBlLCB3aGljaCBpcyBmb3IgcGFzc2luZyBhbiBvYmplY3QgYWxvbmcgdG8gYSBuZXcgZnVuY3Rpb24uCgoKIyMgRmFjZXRpbmcKCkFub3RoZXIgdGhpbmcgd2UgY2FuICJhZGQiIHRvIG91ciBnZ3Bsb3RzIGlzIGEgZmFjZXRpbmcgbGF5ZXIuIEZhY2V0cyBkaXZpZGUgYSBwbG90IGludG8gc3VicGxvdHMgYmFzZWQgb24gb25lIG9mIG91ciB2YXJpYWJsZXMuIEZvciBleGFtcGxlOgoKYGBge3J9CmdncGxvdChocGlfdGlkeSwgYWVzKHggPSBkYXRlLCB5ID0gaHBpLCBjb2xvciA9IGRpdmlzaW9uKSkgKwogIGdlb21fbGluZSgpICsKICBmYWNldF93cmFwKH5kaXZpc2lvbikKYGBgCgoKCiMjIFNjYXR0ZXJwbG90CgpUaGVyZSBhcmUgbWFueSBraW5kcyBvZiBnZW9tcyB3ZSBjYW4gYWRkLiBGb3IgZXhhbXBsZSwgYSBzY2F0dGVycGxvdCB1c2VzIGBnZW9tX3BvaW50KClgLgoKYGBge3J9CmhwaV9wY3QgPC0gCiAgaHBpX3RpZHkgJT4lIAogIG11dGF0ZShwY3RfY2hhbmdlID0gKGhwaSAvIGxhZyhocGkpKSAtIDEsCiAgICAgICAgIHBjdF9jaGFuZ2VfMTJfbW9ucyA9IChocGkgLyBsYWcoaHBpLCAxMikpIC0gMSkgJT4lCiAgbmEub21pdCgpCgpocGlfcGN0ICU+JSAKZ2dwbG90KGFlcyh4ID0gcGN0X2NoYW5nZV8xMl9tb25zLCB5ID0gcGN0X2NoYW5nZSwgY29sb3IgPSBkaXZpc2lvbikpICsKICBnZW9tX3BvaW50KGFscGhhID0gLjEpICsgI2FscGhhID0gLjUKICBmYWNldF93cmFwKH5kaXZpc2lvbiwgbmNvbCA9IDQpICsKICBsYWJzKHggPSAiJSBjaGFuZ2UgKDEgeXIuKSIsIHkgPSAiJSBjaGFuZ2UgKDEgbW8uKSIpICsKICB0aGVtZShsZWdlbmQucG9zaXRpb24gPSAibm9uZSIsCiAgICAgICAgYXhpcy50ZXh0LnggPSBlbGVtZW50X3RleHQoYW5nbGUgPSA5MCwgaGp1c3QgPSAxLCB2anVzdCA9IDAuNSksCiAgICAgICAgcGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dChoanVzdCA9IDAuNSkpCmBgYAoKCiMjIFNjYXR0ZXJwbG90IHdpdGggdHJlbmQgbGluZQoKV2UgY2FuIGFsc28gYWRkIG11bHRpcGxlIGdlb21zIHRvIGEgYGdncGxvdGAgb2JqZWN0LCBlLmcuIGFkZGluZyBhIHRyZW5kIGxpbmUgdG8gb3VyIHNjYXR0ZXJwbG90czoKCmBgYHtyfQpocGlfcGN0ICU+JSAKZ2dwbG90KGFlcyh4ID0gcGN0X2NoYW5nZV8xMl9tb25zLCB5ID0gcGN0X2NoYW5nZSwgY29sb3IgPSBkaXZpc2lvbikpICsKICBnZW9tX3BvaW50KCkgKyAjYWxwaGEgPSAuNQogIGdlb21fc21vb3RoKG1ldGhvZCA9ICJsbSIsIHNlID0gVFJVRSwgY29sb3IgPSAicHVycGxlIikgKwogIGZhY2V0X3dyYXAofmRpdmlzaW9uLCBuY29sID0gNCkgKwogIGxhYnMoeCA9ICIlIGNoYW5nZSAoMSBtby4pIiwgeSA9ICIlIGNoYW5nZSAoMSB5ci4pIikgKwogIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbiA9ICJub25lIiwKICAgICAgICBheGlzLnRleHQueCA9IGVsZW1lbnRfdGV4dChhbmdsZSA9IDkwLCBoanVzdCA9IDEsIHZqdXN0ID0gMC41KSwKICAgICAgICBwbG90LnRpdGxlID0gZWxlbWVudF90ZXh0KGhqdXN0ID0gMC41KSkKYGBgCgoKCiMjIEhpc3RvZ3JhbQoKVGhlcmUgYXJlIGxvdHMgb2Ygd2F5cyB0byBjdXN0b21pemUgdGhlIGxvb2sgYW5kIGZlZWwgb2YgeW91ciBwbG90czoKCmBgYHtyfQpocGlfcGN0ICU+JSAKICBnZ3Bsb3QoYWVzKHggPSBwY3RfY2hhbmdlKSkgKwogIGdlb21faGlzdG9ncmFtKGZpbGwgPSAiZGFya2JsdWUiLCBjb2xvciA9ICJkYXJrcmVkIiwgYmlucyA9IDEwKSArCiAgZmFjZXRfd3JhcCh+ZGl2aXNpb24pICsKICB0aGVtZShheGlzLnRleHQueCA9IGVsZW1lbnRfdGV4dChhbmdsZSA9IDkwLCBoanVzdCA9IDEsIHZqdXN0ID0gMC41KSkgKwogIHRoZW1lX21pbmltYWwoKQpgYGAKCgojIyBEZW5zaXR5CgpgYGB7cn0KaHBpX3BjdCAlPiUgCiAgZ2dwbG90KGFlcyh4ID0gcGN0X2NoYW5nZSkpICsKICBnZW9tX2RlbnNpdHkoZmlsbCA9ICJkYXJrYmx1ZSIsIGNvbG9yID0gImRhcmtyZWQiLCBiaW5zID0gNTApICsKICBmYWNldF93cmFwKH5kaXZpc2lvbikgKwogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gOTAsIGhqdXN0ID0gMSwgdmp1c3QgPSAwLjUpKSArCiAgdGhlbWVfbWluaW1hbCgpCmBgYAoKCiMjIEhpc3RvZ3JhbSBhbmQgRGVuc2l0eQoKYGBge3J9CmhwaV9wY3QgJT4lIAogIGdncGxvdChhZXMoeCA9IHBjdF9jaGFuZ2UpKSArCiAgZ2VvbV9oaXN0b2dyYW0oZmlsbCA9ICJkYXJrYmx1ZSIsIGNvbG9yID0gImRhcmtyZWQiLCBiaW5zID0gMjApICsKICBnZW9tX2RlbnNpdHkoY29sb3IgPSAicmVkIikgKwogIGZhY2V0X3dyYXAofmRpdmlzaW9uKSArCiAgdGhlbWUoYXhpcy50ZXh0LnggPSBlbGVtZW50X3RleHQoYW5nbGUgPSA5MCwgaGp1c3QgPSAxLCB2anVzdCA9IDAuNSkpCmBgYAoKCiMjIFNoYWRpbmcgZm9yIHJlY2Vzc2lvbgoKV2UgY2FuIGV2ZW4gY29tYmluZSBkYXRhc2V0cyBvbiB0aGUgc2FtZSBwbG90LiBMZXQncyBjcmVhdGUgYSBnZW9tIHRvIHNoYWRlIHRoZSBiYWNrZ3JvdW5kIG9mIGEgcGxvdCBkdXJpbmcgcmVjZXNzaW9uIHBlcmlvZHMuCgpgYGB7cn0KIyBGaXJzdCwgY3JlYXRlIG91ciByZWNlc3Npb25zIHRpYmJsZSB3aXRoIHRyaWJibGUoKQpyZWNlc3Npb25zIDwtIAp0cmliYmxlKAogIH5QZWFrLCB+VHJvdWdoLAogICIxOTQ4LTExLTAxIiwgIjE5NDktMTAtMDEiLAogICIxOTUzLTA3LTAxIiwgIjE5NTQtMDUtMDEiLAogICIxOTU3LTA4LTAxIiwgIjE5NTgtMDQtMDEiLAogICIxOTYwLTA0LTAxIiwgIjE5NjEtMDItMDEiLAogICIxOTY5LTEyLTAxIiwgIjE5NzAtMTEtMDEiLAogICIxOTczLTExLTAxIiwgIjE5NzUtMDMtMDEiLAogICIxOTgwLTAxLTAxIiwgIjE5ODAtMDctMDEiLAogICIxOTgxLTA3LTAxIiwgIjE5ODItMTEtMDEiLAogICIxOTkwLTA3LTAxIiwgIjE5OTEtMDMtMDEiLAogICIyMDAxLTAzLTAxIiwgIjIwMDEtMTEtMDEiLAogICIyMDA3LTEyLTAxIiwgIjIwMDktMDYtMDEiLAogICIyMDIwLTAyLTAxIiwgIjIwMjAtMDUtMDEiCiAgKSAlPiUgCiAgbXV0YXRlKFBlYWsgPSB5bWQoUGVhayksCiAgICAgICAgIFRyb3VnaCA9IHltZChUcm91Z2gpKQoKCnJlY2Vzc2lvbl9zaGFkZSA8LSAKICBnZW9tX3JlY3QoZGF0YSA9IHJlY2Vzc2lvbnMsIAogICAgICAgICAgICBpbmhlcml0LmFlcyA9IEYsIAogICAgICAgICAgICBhZXMoeG1pbiA9IFBlYWssIAogICAgICAgICAgICAgICAgeG1heCA9IFRyb3VnaCwgCiAgICAgICAgICAgICAgICB5bWluID0gLUluZiwgCiAgICAgICAgICAgICAgICB5bWF4ID0gK0luZiksIAogICAgICAgICAgICBmaWxsID0gJ3BpbmsnLCAKICAgICAgICAgICAgYWxwaGEgPSAwLjUpCgoKaHBpX3BjdCAlPiUgCiAgZ2dwbG90KGFlcyh4ID0geW1kKGRhdGUpLCB5ID0gcGN0X2NoYW5nZSwgY29sb3IgPSBkaXZpc2lvbikpICsKICByZWNlc3Npb25fc2hhZGUgKwogIGdlb21fbGluZSgpICsKICB0aGVtZV9taW5pbWFsKCkgKwogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gOTAsIGhqdXN0ID0gMSksCiAgICAgICAgcGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dChoanVzdCA9IDAuNSksCiAgICAgICAgcGxvdC5zdWJ0aXRsZSA9IGVsZW1lbnRfdGV4dChoanVzdCA9IDAuNSksCiAgICAgICAgcGxvdC5jYXB0aW9uID0gZWxlbWVudF90ZXh0KGhqdXN0PTApKSArCiAgeWxhYigiIikgKwogIHhsYWIoIlBlcmNlbnQgY2hhbmdlLCBtb250aGx5IikgKwogIGdndGl0bGUoIkhvdXNpbmcgUHJpY2UgQXBwcmVjaWF0aW9uIiwgCiAgICAgICAgICBzdWJ0aXRsZSA9ICJieSBVUyBDZW5zdXMgRGl2aXNpb24iKSArCiAgbGFicyhjYXB0aW9uID0gImRhdGEgc291cmNlOiBGSEZBIikgKwogIHNjYWxlX3hfZGF0ZShsaW1pdHMgPSBjKGFzLkRhdGUobWluKGhwaV9wY3QkZGF0ZSkpLCBhcy5EYXRlKG1heChocGlfcGN0JGRhdGUpKSkpIApgYGAKCgojIGB0aW1ldGtgIGZvciB0aW1lIHNlcmllcyBkYXRhCgpUaGUgW2B0aW1ldGtgXShodHRwczovL2J1c2luZXNzLXNjaWVuY2UuZ2l0aHViLmlvL3RpbWV0ay9pbmRleC5odG1sKSBwYWNrYWdlIGluY2x1ZGVzIGEgYnVuY2ggb2YgZnVuY3Rpb25zIHRoYXQgbWFrZSB3b3JraW5nIHdpdGggdGltZSBzZXJpZXMgZGF0YSBzdXBlciBlYXN5LiBUaGlzIGluY2x1ZGVzIGZ1bmN0aW9ucyBmb3IgZWFzaWx5IGNyZWF0aW5nIGdyZWF0IGxvb2tpbmcgcGxvdHMgb2YgdGltZSBzZXJpZXMgZGF0YToKCmBgYHtyfQpocGlfcGN0ICU+JSAKICB1bmdyb3VwKCkgJT4lIAogIHBsb3RfdGltZV9zZXJpZXMoZGF0ZSwgcGN0X2NoYW5nZSwgLmNvbG9yX3ZhciA9IGRpdmlzaW9uLCAuc21vb3RoID0gRkFMU0UsIC5pbnRlcmFjdGl2ZSA9IEZBTFNFKQpgYGAKCgojIyBBbm9tYWx5IGRpYWdub3N0aWNzIHdpdGggYHRpbWV0a2AKCmB0aW1ldGtgIGFsc28gaW5jbHVkZXMgZnVuY3Rpb25zIGZvciBhdXRvbWF0aWMgYW5vbWFseSBkZXRlY3Rpb246CgpgYGB7cn0KaHBpX3BjdCAlPiUgCiAgZmlsdGVyKGRpdmlzaW9uID09ICJzb3V0aF9hdGxhbnRpY19zYSIpICU+JSAKICB1bmdyb3VwKCkgJT4lIAogIHBsb3RfYW5vbWFseV9kaWFnbm9zdGljcyhkYXRlLCBwY3RfY2hhbmdlLCAuYWxwaGEgPSAuMDMpCmBgYAoKCiMgUGxvdGx5IGFuZCBgZ2dwbG90bHkoKWAKCmB0aW1ldGtgJ3MgaW50ZXJhY3RpdmUgcGxvdHMgcmVseSBvbiBbcGxvdGx5XShodHRwczovL3Bsb3RseS5jb20vci8pLCBhIGxpYnJhcnkgZm9yIGJ1aWxkaW5nIGludGVyYWN0aXZlIEphdmFTY3JpcHQgdmlzdWFsaXphdGlvbnMuIFBsb3RseSBpcyBzdXBwb3J0ZWQgaW4gc2V2ZXJhbCBkaWZmZXJlbnQgbGFuZ3VhZ2VzIChpbmNsdWRpbmcgUikgYW5kIGhhcyBpdHMgb3duIHN5bnRheC4KCkltcG9ydGFudGx5LCB0aGUgYHBsb3RseWAgUiBwYWNrYWdlIGluY2x1ZGVzIGEgZnVuY3Rpb24gY2FsbGVkIGBnZ3Bsb3RseSgpYCB0aGF0ICh5b3UgZ3Vlc3NlZCBpdCEpIHR1cm5zIGdncGxvdHMgaW50byBwbG90bHkgY2hhcnRzLgoKYGBge3J9CmhwaV9wbG90IDwtIGdncGxvdChocGlfdGlkeSwgYWVzKHggPSBkYXRlLCB5ID0gaHBpLCBjb2xvciA9IGRpdmlzaW9uKSkgKwogIGdlb21fbGluZSgpCgpocGlfcGxvdCAlPiUgCiAgZ2dwbG90bHkoKQpgYGAKCgoKCgoK